home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbcmp.zip / D1.BAS < prev    next >
BASIC Source File  |  1992-08-06  |  8KB  |  293 lines
  1. 'Experimental LZW Decompressor for PDS / QuickBASIC 4.5
  2. 'By Rich Geldreich 1992
  3. 'This program is in the public domain: use as you wish!
  4. '(QB4.5 users: Use search & replace to change all of the "SSEG" strings
  5. 'to "VARSEG" strings in this program.)
  6. 'If you have and questions or problems, write/call:
  7.  
  8. 'Rich Geldreich
  9. '410 Market St.
  10. 'Gloucester City, NJ 08030
  11. '(609)-742-8752
  12. '
  13. ' Do not press ctrl+break while this program is decompressing! The string
  14. ' pointers may change, which may result in an error!
  15.  
  16. DEFINT A-Z
  17. DECLARE SUB PutByte (A)
  18. DECLARE SUB Rebuild.Table (New.Entries)
  19. DECLARE FUNCTION GetCode ()
  20. DECLARE FUNCTION GetByte ()
  21. CONST True = -1, False = 0
  22.  
  23. 'Prefix & Suffix of each code
  24. DIM SHARED Prefix(4096), Suffix(4096), Used(4096)
  25. DIM OutCode(4096)               'simulates a hardware stack
  26.  
  27. 'Input and output disk buffers
  28. DIM SHARED InBuffer$, IAddress, IEndAddress, Iseg
  29. DIM SHARED OutBuffer$, OStartAddress, OAddress, OEndAddress, Oseg
  30.  
  31. 'Used for screen updating
  32. DIM SHARED BytesIn&
  33.  
  34. 'Powers of two
  35. DIM SHARED Powers(7)
  36. DIM SHARED LongPowers(12) AS LONG
  37. 'Mask for each codesize
  38. DIM SHARED Masks(12)
  39. 'Current codesize
  40. DIM SHARED CodeSize
  41. 'Initialize each array
  42. FOR A = 0 TO 7: Powers(A) = 2 ^ A: NEXT
  43. FOR A = 0 TO 12: LongPowers(A) = 2 ^ A: NEXT
  44. FOR A = 1 TO 12: Masks(A) = (2 ^ A) - 1: NEXT
  45. 'Turn on cursor
  46. LOCATE , , 1
  47. 'Initialize each disk buffer
  48. InBuffer$ = STRING$(5000, 0)
  49. OutBuffer$ = STRING$(5000, 0)
  50. 'Find address of output buffer
  51. A& = SADD(OutBuffer$)
  52. A& = A& - 65536 * (A& < 0)
  53. Oseg = SSEG(OutBuffer$) + (A& \ 16)
  54. OAddress = (A& MOD 16)
  55. OEndAddress = OAddress + 5000
  56. OStartAddress = OAddress
  57. BytesIn& = 0
  58. 'Open files
  59. OPEN "OUTPUT.LZW" FOR BINARY AS #1
  60. OPEN COMMAND$ FOR BINARY AS #2
  61.  
  62. 'First code is 259
  63. FreeCode = 259
  64. StartCode = 259
  65. 'First codesize is 9 bits
  66. CodeSize = 9
  67. 'Get First code(special case)
  68. Code = GetCode
  69. CurCode = Code
  70. OldCode = Code
  71. FinChar = Code
  72. PutByte FinChar
  73.  
  74. FileLength& = LOF(1)
  75. IF POS(0) <> 1 THEN PRINT
  76. PRINT "LZW Decompressor in QuickBASIC 4.5"
  77. PRINT "By Richard Geldreich June 2nd, 1992"
  78. PRINT "Decompressing:";
  79. Y = CSRLIN: X = POS(0)
  80. 'Main decompression loop
  81. DO
  82.     'Update screen every 1,024 codes
  83.     OutputCounter = OutputCounter + 1
  84.     IF OutputCounter = 1024 THEN
  85.         LOCATE Y, X
  86.         PRINT (100& * BytesIn&) \ FileLength&; "% done";
  87.         OutputCounter = 0
  88.     END IF
  89.  
  90. GetCode:
  91.     'Get code from input file
  92.     Code = GetCode
  93.     'Process code
  94.     SELECT CASE Code
  95.     'End of file code
  96.     CASE 256
  97.         OutBuffer$ = LEFT$(OutBuffer$, OAddress - OStartAddress)
  98.         PUT #2, , OutBuffer$
  99.         LOCATE Y, X
  100.         PRINT " done       "
  101.         CLOSE : END
  102.     'Increase code size code
  103.     CASE 257
  104.         CodeSize = CodeSize + 1
  105.     CASE 258
  106.         Rebuild.Table New.Entries
  107.         FreeCode = New.Entries + StartCode
  108.         CodeSize = 9
  109.  
  110.         IF FreeCode > 4096 THEN
  111.             FreeCode = StartCode
  112.             Code = GetCode
  113.              
  114.             CurCode = Code
  115.             OldCode = Code
  116.              
  117.             FinChar = Code
  118.             PutByte FinChar
  119.         ELSE
  120.             'prevents an invalid code from entering the table
  121.             Ignore.Next = True
  122.         END IF
  123.  
  124.     'Process a code
  125.     CASE ELSE
  126.        
  127.         CurCode = Code
  128.         InCode = Code
  129.         'Do we have this string yet?
  130.         IF Code >= FreeCode THEN
  131.             'If Code>FreeCode then stop decompression: this can't be right!
  132.             IF Code > FreeCode THEN PRINT "??BAD LZW CODE IN FILE": CLOSE : END
  133.             'Trick decompressor to use last code
  134.             
  135.             Used(Code) = Used(Code) + 1
  136.             CurCode = OldCode
  137.             OutCode(OutCount) = FinChar
  138.             OutCount = OutCount + 1
  139.         END IF
  140.         
  141.         'Does this code represent a string?
  142.         IF CurCode >= StartCode THEN
  143.             'Get each character from the table and push it onto the stack
  144.             
  145.             DO
  146.                 Used(CurCode) = Used(CurCode) + 1
  147.                 OutCode(OutCount) = Suffix(CurCode)
  148.                 OutCount = OutCount + 1
  149.                 CurCode = Prefix(CurCode)
  150.             'keep on doing this until we have a normal character
  151.             LOOP UNTIL CurCode <= 255
  152.         END IF
  153.         FinChar = CurCode
  154.         OutCode(OutCount) = FinChar
  155.         'Pop all the codes of the stack and put them into the output file
  156.         FOR A = OutCount TO 0 STEP -1
  157.             PutByte OutCode(A)
  158.         NEXT
  159.         OutCount = 0
  160.         'Put the new string into the table
  161.         IF Ignore.Next THEN
  162.             Ignore.Next = False
  163.         ELSE
  164.             Prefix(FreeCode) = OldCode
  165.             Suffix(FreeCode) = FinChar
  166.             FreeCode = FreeCode + 1
  167.         END IF
  168.         OldCode = InCode
  169.     END SELECT
  170. LOOP
  171.  
  172. FUNCTION GetByte STATIC
  173.     IF IAddress = IEndAddress THEN
  174.         GET #1, , InBuffer$
  175.         A& = SADD(InBuffer$)
  176.         A& = A& - 65536 * (A& < 0)
  177.         Iseg = SSEG(InBuffer$) + (A& \ 16)
  178.         IAddress = (A& MOD 16)
  179.         IEndAddress = IAddress + 5000
  180.     END IF
  181.     DEF SEG = Iseg
  182.     GetByte = PEEK(IAddress)
  183.     BytesIn& = BytesIn& + 1
  184.     IAddress = IAddress + 1
  185. END FUNCTION
  186.  
  187. FUNCTION GetCode STATIC
  188.     IF BitsLeft = 0 THEN
  189.         TempChar = GetByte
  190.         BitsLeft = 8
  191.     END IF
  192.     WorkCode& = TempChar \ Powers(8 - BitsLeft)
  193.     DO WHILE CodeSize > BitsLeft
  194.         TempChar = GetByte
  195.         WorkCode& = WorkCode& OR TempChar * LongPowers(BitsLeft)
  196.         BitsLeft = BitsLeft + 8
  197.     LOOP
  198.     BitsLeft = BitsLeft - CodeSize
  199.     GetCode = WorkCode& AND Masks(CodeSize)
  200. END FUNCTION
  201.  
  202. SUB PutByte (A) STATIC
  203.     IF OAddress = OEndAddress THEN
  204.         PUT #2, , OutBuffer$
  205.         OAddress = OStartAddress
  206.     END IF
  207.     DEF SEG = Oseg
  208.     POKE OAddress, A
  209.     OAddress = OAddress + 1
  210. END SUB
  211.  
  212. SUB Rebuild.Table (New.Entries)
  213.     DIM P(4095), S(4095), U(4095) AS LONG, Pn(4095), C(4095)
  214.     DIM location(4095)
  215.    
  216.     SHARED StartCode, OldCode
  217.    
  218.     Num.Entries = 0
  219.     FOR A = StartCode TO 4095
  220.         IF Used(A) > 0 THEN
  221.             Used(A) = 0
  222.             P = Prefix(A): S = Suffix(A)
  223.             P(Num.Entries) = P
  224.             S(Num.Entries) = S
  225.             U(Num.Entries) = P * 4096& + S
  226.             C(A) = Num.Entries
  227.             Num.Entries = Num.Entries + 1
  228.         END IF
  229.     NEXT
  230.   
  231.  
  232.     Num.Entries = Num.Entries - 1
  233.     FOR A = 0 TO Num.Entries
  234.         Pn(A) = A
  235.     NEXT
  236.   
  237.     Mid = Num.Entries \ 2
  238.     DO
  239.         FOR A = 0 TO Num.Entries - Mid
  240.             IF U(Pn(A)) > U(Pn(A + Mid)) THEN
  241.                 SWAP Pn(A), Pn(A + Mid)
  242.                 Swap.Flag = True
  243.                 CompareLow = A - Mid
  244.                 CompareHigh = A
  245.                 DO WHILE CompareLow >= 0
  246.                     IF U(Pn(CompareLow)) > U(Pn(CompareHigh)) THEN
  247.                         SWAP Pn(CompareLow), Pn(CompareHigh)
  248.                         CompareHigh = CompareLow
  249.                         CompareLow = CompareLow - Mid
  250.                     ELSE
  251.                         EXIT DO
  252.                     END IF
  253.                 LOOP
  254.               
  255.             END IF
  256.         NEXT
  257.        
  258.         Mid = Mid \ 2
  259.     LOOP WHILE Mid > 0
  260.    
  261.    
  262.     FOR A = 0 TO Num.Entries
  263.         location(Pn(A)) = A
  264.     NEXT
  265.    
  266.     
  267.    
  268.     FOR A1 = 0 TO Num.Entries
  269.         A = Pn(A1)
  270.      
  271.         P = P(A)
  272.         S = S(A)
  273.         IF P >= StartCode THEN
  274.             P = StartCode + location(C(P))
  275.         END IF
  276.         IF S >= StartCode THEN
  277.             S = StartCode + location(C(S))
  278.         END IF
  279.        
  280.         Prefix(A1 + StartCode) = P
  281.         Suffix(A1 + StartCode) = S
  282.        
  283.     NEXT
  284.     
  285.     IF OldCode >= StartCode THEN
  286.         OldCode = StartCode + location(C(OldCode))
  287.     END IF
  288.    
  289.     New.Entries = Num.Entries + 1
  290.  
  291. END SUB
  292.  
  293.